home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The PC-SIG Library 9
/
The PC-SIG Library on CD ROM - Ninth Edition.iso
/
101_200
/
DISK0112
/
DISK0112.ZIP
/
PC-CODE1.153
< prev
next >
Wrap
Text File
|
1984-06-14
|
21KB
|
775 lines
'
'
' <<<<< P C - C O D E 3 . 1 5 3 >>>>>
'
'
' * * * * * * * * * * * * * * * * * * * *
' * *
' * COPYRIGHT 1984 by *
' * Richard Nolen COLVARD *
' * Freeware distribution OK *
' * Public Domain use OK *
' * *
' * WARNING: This Program must be *
' * COMPILED with IBM *
' * BASCOM/T/O/N *
' * Donot use BASICA *
' * *
' * Highly recommend 8087 Link Libs *
' * *
' * * * * * * * * * * * * * * * * * * * *
'
'
DIM B#(37), C#(99), CONS!(7), CONS#(6)
DIM ZI$(4), ZO$(4) ' Dummy dimensions for field stmst ND error
DIM BCNT%(37), CCNT%(99), CHNO%(256)
DIM BIT%(1024), CH%(1024), PW2%(8)
CONS!(1)=8: CONS!(2)=131072! : CONS!(3)=8192: CONS!(4)=128
CONS!(5)=2: CONS!(6)=32 : CONS!(7)=2048
CONS#(1)=1: CONS#(2)=128 : CONS#(3)=32768#: CONS#(4)=8388608#
CONS#(5)=4096 : CONS#(6)=1048576# : ACNT!=0
M%=7: N%=17: YY# = 999991! : MU# = 16807 : MD# = 2147483647#
SAME1! = 0 : SAME2! = 0 : TOT! = 0
YES% = ASC("Y") : NO% = ASC("N")
WZ$="P C C o m p u t e r S e c u r i t y V1.53 PC-CODE1"
FOR J%=1 TO 37 : BCNT%(J%)=0 : NEXT J%
FOR J%=1 TO 99 : CCNT%(J%)=0 : NEXT J%
FOR J%=1 TO 256: CHNO%(J%)=0 : NEXT J%
PRINT WZ$ : PRINT : PRINT
PRINT "Does your Terminal Support IBM Clear (CLS) Screen";
GOSUB 8300 : IBM% = REPLY%
PRINT: PRINT
PRINT "Do you have COLOR installed on your PC";
GOSUB 8300 : CL% = REPLY%
IF CL% = 0% THEN 1530
SCREEN 0,1
COLOR 15,9,1
GOSUB 8190
1530 PRINT: PRINT
YES% = ASC("B") : NO% = ASC("C")
PRINT "Do you want Character (C) or Bit (B) Scrambling";
GOSUB 8300 : XL% = REPLY%
IF XL% = 0% THEN 1600
PW2%(1) = 1%
PW2%(2) = 2%
PW2%(3) = 4%
PW2%(4) = 8%
PW2%(5) = 16%
PW2%(6) = 32%
PW2%(7) = 64%
PW2%(8) = 128%
JK% = 1%
FOR J% = 1% TO 128%
FOR K% = 1% TO 8%
BIT%(JK%) = PW2%(K%)
CH%(JK%) = J%
JK% = JK% + 1%
NEXT K%
NEXT J%
GOTO 1650
1600 FOR J%=1% TO 128%
CH%(J%) = 129% - J%
NEXT J%
1650 YES% = ASC("Y") : NO% = ASC("N")
PRINT : PRINT
PRINT "Do You wish some Instructions/Help";
GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 6600
PRINT : PRINT
YES% = ASC("Y") : NO% = ASC("N")
PRINT "Do You Wish to Load KEYS from a FILE";
GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 6800 : GOTO 2740
GOSUB 8190
FOR J% = 10 TO 15
IF CL% = 1% THEN COLOR J%,9,1
PRINT "P C - C O D E 1 ......SuperEncipherment......"
NEXT J%
IF CL% = 1% THEN COLOR 15,9,1
PRINT: PRINT : PRINT : PRINT : PRINT : PRINT
YES% = ASC("N") : NO% = ASC("A")
PRINT " Enter the type of KEY desired"
PRINT " Numeric; Number Only key ";
IF CL% = 1% THEN COLOR 13,0,0: PRINT "N": COLOR 15,9,1
IF CL% = 0% THEN PRINT "N"
PRINT " Alphabetic; alphanumeric ";
IF CL% = 1% THEN COLOR 13,0,0: PRINT "A" : COLOR 15,9,1
IF CL% = 0% THEN PRINT "A"
GOSUB 8300 : TY% = REPLY% : IF REPLY% = 0% THEN 3960
'
'
'
GOSUB 8190
YES% = ASC("H"): NO% = ASC("L")
PRINT " There are two(2) levels of Security HIGH and LOW"
PRINT " Enter H for HIGH or L for LOW";
GOSUB 8300 : IF REPLY% = 1% THEN 2170
'
' ----------- LOW level of SECURITY -------------
'
PRINT " LOW Level of Security Selected"
PRINT
PRINT " You must now enter SEVEN (7) KEY numbers as indicated:"
PRINT
GOSUB 4170
GOTO 2740
'
'
'
2170 PRINT
PRINT " You have Selected HIGH security"
PRINT
PRINT " You must enter ";1+N%+M%;" key numbers between 1 and 2,147,483,646"
2210 INPUT " A( 1 ) ? "; A#
A# = FIX(A#)
IF A# < 1 OR A# >= MD# THEN GOSUB 2590: GOTO 2210
PRINT
'
'
FOR J%=1 TO M%
2280 PRINT " B(";J%;") ";
INPUT B#(J%)
B#(J%) = FIX(B#(J%))
IF B#(J%) < 1 OR B#(J%) >= MD# THEN GOSUB 2590: GOTO 2280
NEXT J%
GOSUB 8190
'
'
FOR J%=1 TO N%
2370 PRINT " C(";J%;") ";
INPUT C#(J%)
C#(J%) = FIX(C#(J%))
IF C#(J%) < 1 OR C#(J%) >= MD# THEN GOSUB 2590: GOTO 2370
IF J% = 18 THEN GOSUB 8190
IF J% = 36 THEN GOSUB 8190
NEXT J%
'
GOTO 2740
'
'
'
2490 PRINT "[";X%;"] ";
INPUT "Enter a NUMBER between 1 and 9,999,999 "; K2!
IF K2! < 1 OR K2! > 9999999! THEN GOSUB 2590: GOTO 2490
Z! = K2!
GOSUB 2680
S! = Z!
RETURN
'
'
' ---------- ERROR Messages ----------
2590 IF CL% = 1% THEN COLOR 4+16,0,0
PRINT " ERROR: Number RANGE must be 1 to 9,999,999"
IF CL% = 1% THEN COLOR 15,1,9
RETURN
'
'
' ------ scaling ---------
2680 Z! = Z! / 100!
IF Z! > 1! THEN 2680
RETURN
'
'
'
2740 GOSUB 8190
PRINT : PRINT
PRINT " Input and Output File may be the same file"
PRINT " Only Valid files; no use of 'CON:' or 'LPT1:'"
PRINT : PRINT
INPUT "Enter Output file name (Full name): "; U$
OPEN "R",2,U$,512
INPUT "Enter Input FILE (full name): "; F1$
OPEN "I",1,F1$
CLOSE 1
OPEN "R",1,F1$,512
FIELD #1,128 AS ZI$(1),128 AS ZI$(2),128 AS ZI$(3),128 AS ZI$(4)
FIELD #2,128 AS ZO$(1),128 AS ZO$(2),128 AS ZO$(3),128 AS ZO$(4)
L! = LOF(1) : SIZE% = L! / 128
IF (SIZE% * 128!) <> L! THEN SIZE% = SIZE% + 1
SIZ2% = L! / 512
IF (SIZ2% * 512) <> L! THEN SIZ2% = SIZ2% + 1
PRINT
YES% = ASC("E") : NO% = ASC("D")
PRINT "Encode or Decode";
GOSUB 8300 : EN% = REPLY%
GOSUB 8190
ZER$ = STRING$(128,0)
IF CL% = 1% THEN COLOR 4+16,0,0
IF CL% = 0% THEN COLOR 7+16,0
PRINT " * * * R U N N I N G * * *"
IF CL% = 1% THEN COLOR 15,9,1
IF CL% = 0% THEN COLOR 7,0
PRINT
LAST%=0
IF XL% = 1% THEN GOSUB 9100
FOR Z9% = 1% TO SIZ2%
GET #1, Z9%
IF XL% = 0% THEN GOSUB 9100
IF XL% = 1% AND (Z9% MOD 9%) = 0% THEN GOSUB 9100
FOR JK% = 1% TO 4%
IF LAST% >= SIZE% THEN LSET ZO$(JK%) = ZER$ : GOTO 3450
M$=ZI$(JK%)
IF Z9% = SIZ2% AND EN% = 0% AND M$ = ZER$ THEN 3430
IF EN% = 0% THEN GOSUB 9200
FOR J% = 1% TO 128%
H%=ASC( MID$(M$,J%,1%) )
S#=A#
L=M%
GOSUB 3530
A#=S#
B%=O%
L=N%
S#=B#(B%)
BCNT%(B%) = BCNT%(B%) + 1%
GOSUB 3530
B#(B%)=S#
B%=O%
S#=C#(B%)
CCNT%(B%) = CCNT%(B%) + 1%
L=256
GOSUB 3530
C#(B%)=S#
H% = H% XOR O%
H% = H% AND 255%
CHNO%(H%) = CHNO%(H%) + 1%
MID$(M$,J%,1) = CHR$(H%)
NEXT J%
IF EN% = 1% THEN GOSUB 9200
3430 LSET ZO$(JK%) = M$
LAST% = LAST% + 1%
3450 NEXT JK%
PUT #2, Z9%
NEXT Z9%
'
GOTO 3680
'
'
' -------- RANDOM NUMBER GENERATOR (1) ------
3530 S# = S# * MU#
S# = S# - ( MD# * INT( S# / MD# ) )
O%=1 + INT(L * (S# / MD#) )
RETURN
'
'
' -------- RANDOM NUMBER GENERATOR (2) ------
3600 S!=(S! + 1.352968) ^ 1.256973
S!=S! - FIX(S!)
O%=1 + INT(L * S!)
RETURN
'
'
'
' ------- CLEAR STORAGE & PREPARE TO STOP ---------
3680 LSET ZO$(4)=ZER$ : LSET ZI$(4)=ZER$
LSET ZO$(1)=ZER$ : LSET ZI$(1)=ZER$
LSET ZO$(2)=ZER$ : LSET ZI$(2)=ZER$
LSET ZO$(3)=ZER$ : LSET ZI$(3)=ZER$
CLOSE 2
CLOSE 1
YES% = ASC("Y") : NO% = ASC("N")
PRINT "Wish to Save newly Computed Keys to a File";
GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 7030
PRINT "Wish to Save Log Statistics for Keys used";
GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 7630
Z!=0: A#=0# : M2$=ZER$ : M$=M2$ : S! = 0: S# = 0
FOR J%=1 TO M%
B#(J%)=0# : BCNT%(J%)=0%
NEXT J%
FOR J%=1 TO N%
C#(J%)=0# : CCNT%(J%)=0%
NEXT J%
FOR J%=1 TO 1024%
BIT%(J%) = 0% : CH%(J%) = 0%
NEXT J%
IF CL% = 1% THEN COLOR 7,0,0
IF IBM% = 1% THEN CLS
END ' S T O P
'
' ----------- ALPHANUMERIC KEYS -----------
'
3960 GOSUB 8190
YES% = ASC("H") : NO% = ASC("L")
PRINT
PRINT " There are two(2) levels of Security HIGH and LOW"
PRINT " Enter H for HIGH or L for LOW ";
GOSUB 8300 : IF REPLY% = 1% THEN 5270
'
' ----------- LOW level of SECURITY -------------
'
PRINT " LOW Level of Security Selected"
PRINT
PRINT " You must now enter SEVEN (7) key Alphanumerics as indicated:"
PRINT
GOSUB 4170
GOTO 2740
'
'
' ---------- KEY 1 ---------
4170 X%=1% : M% = 11% : N% = 47%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
GOSUB 3600
A#=FIX((1# - S!) * MD#)
'
'
' ---------- KEY 2 ----------
X%=2%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
L=4
FOR J%=1 TO M%
GOSUB 3600
O2% = O%
FOR K%=1 TO O2%
GOSUB 3600
NEXT K%
GOSUB 3600
B#(J%)=FIX((1# - S!) * MD#)
NEXT J%
'
'
' ---------- KEY 3 -----------
X%=3%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
L=3
FOR J%=1 TO N%
GOSUB 3600
O2% = O%
FOR K%=1 TO O2%
GOSUB 3600
NEXT K%
GOSUB 3600
C#(J%)=FIX((1# - S!) * MD#)
NEXT J%
'
'
' ---------- KEY 4 -------------
X%=4%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
L=INT(N%/2)
GOSUB 3600
K%=O% + 1
L=N%
FOR J%=1 TO K%
GOSUB 3600
L%=O%
GOSUB 3600
C#(L%)=FIX(S! * MD#)
NEXT J%
'
'
' ----------- KEY 5 ---------------
X%=5%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
L=INT(M%/2)
GOSUB 3600
K%=O% + 1
L=M%
FOR J%=1 TO K%
GOSUB 3600
L%=O%
GOSUB 3600
B#(L%)=FIX(S! * MD#)
NEXT J%
'
'
' ------------ KEY 6 ---------------
X%=6%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
L=M%
FOR J%=1 TO M%
GOSUB 3600
D#=B#(O%)
B#(O%)=B#(J%)
B#(J%)=D#
NEXT J%
'
'
' ------------- KEY 7 --------------
X%=7%
IF TY% = 0% THEN GOSUB 5410 ' Alpha
IF TY% = 1% THEN GOSUB 2490 ' Numeric
GOSUB 3600
L=N%
FOR J%=1 TO N%
GOSUB 3600
D#=C#(O%)
C#(O%)=C#(J%)
C#(J%)=D#
NEXT J%
'
GOSUB 7400 ' Display generated Keys
'
RETURN
'
' ---------- end of LOW security ------------
'
'
5270 GOSUB 8190
PRINT " You must enter 3 long PASSWORDS of alphanumeric data"
X%=1%
GOSUB 5600
X%=M%
GOSUB 5600
X%=N%
GOSUB 5600
GOSUB 7400 ' Display generated keys
'
GOTO 2740
'
'
' --------- alphanumeric password to RND ------------
5410 PRINT "[";X%;"] Enter Password: ";
LINE INPUT P$
L%=LEN(P$)
IF L% < 6% THEN PRINT "*** Password Too SHORT; not > 5": GOTO 5410
IF X%=1% THEN K#=0#
FOR J%=1% TO L%
C%=ASC( MID$(P$,J%,1) )
LL%=J%
IF LL% > 7% THEN LL% = LL% MOD 7% : LL% = LL% + 1%
K# = K# + (CONS!(LL%) * C%)
NEXT J%
Z! = K#
GOSUB 2680
K# = K# - ( YY# * INT( K# / YY#))
S! = Z!
RETURN
'
'
' ------- alphanumeric to DECIMAL --------
5600 X2%=X% * 6%
X3%=X2% : X4%=0%
IF X%=1 THEN PRINT " (A) Enter Password of at least (MIN) ";X2%;" Chars"
IF X%=M% THEN PRINT " (B) Enter Password of at least (MIN) ";X2%;" Chars"
IF X2% > 60 THEN X3%=60: X4%=X2% - 60: GOSUB 8190
IF X%=N% THEN PRINT " (C) Enter Password of at least (MIN) ";X2%;" Chars"
W1$="123456789012345678901234567890123456789012345678901234567890"
W2$=" 1 2 3 4 5 6"
W3$=".........+.........+.........+.........+.........+.........+"
W4$=" 7 8 9 10 11 12"
PRINT
PRINT " "; LEFT$(W2$,X3%)
PRINT " "; LEFT$(W1$,X3%)
PRINT " "; LEFT$(W3$,X3%)
PRINT "Password:";
LINE INPUT P$
PRINT
IF X4% = 0% THEN 5810
PRINT
PRINT " "; LEFT$(W4$,X4%)
PRINT " "; LEFT$(W1$,X4%)
PRINT " "; LEFT$(W3$,X4%)
PRINT "Password:";
LINE INPUT P2$
P$ = P$ + P2$
5810 L%=LEN(P$)
IF L% < X2% THEN PRINT " *** Password TOO SHORT reenter ": GOTO 5600
T%=INT(L%/X%)
K#=0
FOR K%=1 TO X%
P2$=LEFT$(P$,T%)
L%=L%-T%
IF L% < 1 THEN 5900
P$=RIGHT$(P$,L%)
5900 FOR J%=1% TO T%
LL%=J%
IF LL% > 6% THEN LL% = LL% MOD 6% : LL% = LL% + 1%
C% = ASC( MID$(P2$,J%,1) )
K# = K# + (CONS#(LL%) * C%)
NEXT J%
IF X%=1 THEN A#=K#
IF X%=M% THEN B#(K%) = K#
IF X%=N% THEN C#(K%) = K#
K# = K# - (MD# * INT( K# / MD# ))
NEXT K%
RETURN
'
'
' ------ bit TRANSPOSITION -------
'
6060 FOR JJ% = 1% TO 1024%
L=M%
S#=A#
GOSUB 3530
A#=S#
B%=O%
L=N%
S#=B#(B%)
GOSUB 3530
B#(B%)=S#
B%=O%
S#=C#(B%)
L=1024
GOSUB 3530
C#(B%)=S#
IS% = BIT%(JJ%)
BIT%(JJ%) = BIT%(O%)
BIT%(O%) = IS%
IS% = CH%(JJ%)
CH%(JJ%) = CH%(O%)
CH%(O%) = IS%
NEXT JJ%
RETURN
'
'
'
6340 FOR JJ% = 1% TO 512%
X1% = CH%(JJ%)
B1% = BIT%(JJ%)
IS% = JJ% + 512%
X2% = CH%(IS%)
B2% = BIT%(IS%)
C1% = ASC( MID$(M$,X1%,1) )
IF X1% = X2% THEN GOSUB 6500 : GOTO 6390
C2% = ASC( MID$(M$,X2%,1) )
S1% = B1% AND C1%
S2% = B2% AND C2%
IF S1% = 0% AND S2% = 0% THEN 6400
IF S1% > 0% AND S2% > 0% THEN 6400
C1% = C1% XOR B1%
C2% = C2% XOR B2%
MID$(M$,X2%,1) = CHR$(C2%)
6390 MID$(M$,X1%,1) = CHR$(C1%)
6400 NEXT JJ%
RETURN
'
'
'
' ----- SAME CHARACTER different bits ----
6500 S1% = B1% AND C1%
S2% = B2% AND C1%
IF S1% = 0% AND S2% = 0% THEN 6550
IF S1% > 0% AND S2% > 0% THEN 6550
C1% = C1% XOR B1%
C1% = C1% XOR B2%
6550 RETURN
'
'
'
'
' ------ Help / Instructions -----
6600 OPEN "I",#3,"PC-CODE1.DOC"
6620 GOSUB 8190
JJ%=1
6650 IF EOF(3) <> 0 THEN 6740
LINE INPUT #3, M$
PRINT M$
JJ%=JJ%+1
IF JJ% < 18 THEN 6650
PRINT "=======================": PRINT
PRINT "Wish More Documentation <CR>=Yes ";
NO% = ASC("N") : YES% = 32%
GOSUB 8300 : IF REPLY% = 1% THEN 6620 ELSE 6750
6740 GOSUB 7220 ' Pause
6750 GOSUB 8190
CLOSE 3
RETURN
'
'
'
6800 INPUT "Enter the fully qualified Input Key File Name: "; F$
OPEN "I", 5, F$
LINE INPUT #5, P$
IF LEFT$(P$,1) <> "*" THEN A#=VAL(P$) : GOTO 6870
INPUT #5, T%, M%, N%
6850 IF T% <> 1 THEN PRINT "*** ERROR *** Bad Key File": END
INPUT #5, A#
6870 A# = ABS( FIX( A# ) )
IF A# = 0# THEN T% = 99 : GOTO 6850
T% = M% + N% + 1
FOR J%=1 TO M% : INPUT #5, B#(J%)
B#(J%) = ABS( FIX( B#(J%) ) ) : NEXT J%
FOR J%=1 TO N% : INPUT #5, C#(J%)
C#(J%) = ABS( FIX( C#(J%) ) ) : NEXT J%
IF EOF(5) <> 0 THEN PRINT "*** ERROR *** Reading key file": END
PRINT "*** Loaded "; T% ;" Keys from "; F$; " Successfully"
GOSUB 7220 ' Pause
CLOSE 5
RETURN
'
'
'
7030 INPUT "Enter the fully qualified Output Key File Name: "; F$
OPEN "O", 5, F$
PRINT #5, "* HDR PC-CODE1 saved KEYS "
WRITE #5, 1, M%, N%
PRINT #5, A#
FOR J%=1 TO M% : PRINT #5, B#(J%)
NEXT J%
FOR J%=1 TO N% : PRINT #5, C#(J%)
NEXT J%
PRINT #5, "* Keys Computed on " + DATE$ + " " + TIME$
T% = M% + N% + 1
PRINT "*** Saved "; T% ;" Keys to "; F$; " Successfully"
GOSUB 7220 ' Pause
CLOSE 5
RETURN
'
'
'
' -------- Delay Function -------
7220 PRINT : PRINT
PRINT " <PAUSE> Press Enter to Continue ";
LINE INPUT Z$
RETURN
'
'
'
' ----- Generated Key Seeds display ------
7400 GOSUB 8190
PRINT "The following Numeric Keys/Seeds were generated:"
PRINT : PRINT
P$=SPACE$(16)
PRINT " ( A ) : "; A#
PRINT
PRINT " ( B ) : ";
FOR J%=1 TO M%
PRINT LEFT$(STR$(B#(J%))+P$,16);
NEXT J%
PRINT : PRINT
PRINT " ( C ) : ";
FOR J%=1 TO N%
PRINT LEFT$(STR$(C#(J%))+P$,16);
NEXT J%
PRINT: PRINT
PRINT " --- To Print this screen depress 'Shift PrtSc' ---"
GOSUB 7220 ' Pause
RETURN
'
'
'
' ---- Save Log Statistics for Keys used -----
7630 PRINT "Enter Stat Log File Name or 'LPT1:' or default of blank"
F$ = " "
INPUT "Enter Log File Name: "; F$
IF LEN(F$)=0 OR LEFT$(F$,1)=" " THEN F$="PC-STAT1.LOG"
OPEN "O", 6, F$
FOR J%=1 TO M% : ACNT! = ACNT! + BCNT%(J%) : NEXT J%
PRINT #6, " "
PRINT #6, " <<<<< PC-CODE1 Statistics for Keys Used >>>>>"
PRINT #6, " " : PRINT #6, " "
PRINT #6, " Date and Time Stamp = "; DATE$ + " " + TIME$
PRINT #6, " Keys Setup (B) size = "; M%
PRINT #6, " Keys Setup (C) size = "; N%
PRINT #6, " Total Characters processed = "; ACNT!
PRINT #6, " "
PRINT #6, " ----- Key Utilitization/Balance -----"
PRINT #6, " " : PRINT #6, " "
PRINT #6, " * For Key Group (B)"
PRINT #6, " "
PRINT #6, " KEY Count"
FOR J%=1 TO M%
PRINT #6, USING " ### ####### "; J%, BCNT%(J%)
NEXT J%
PRINT #6, " " : PRINT #6, " "
PRINT #6, " * For Key Group (C)"
PRINT #6, " "
PRINT #6, " KEY Count"
FOR J%=1 TO N%
PRINT #6, USING " ### ####### "; J%, CCNT%(J%)
NEXT J%
PRINT #6, " " : PRINT #6, " "
PRINT #6, " * Output Character Set Statistics:"
PRINT #6, " "
PRINT #6, " CHR$ Char Count"
PRINT #6, " Num ---- Occur"
FOR J%=0 TO 255
IF CHNO%(J%)=0 THEN 7980
IF J% > 31 AND J% < 127 THEN P$=CHR$(J%) ELSE P$=" "
PRINT #6, USING " #### ! ####### "; J%, P$, CHNO%(J%)
7980 NEXT J%
PRINT #6, " "
PRINT #6, " *** END of STATISTICAL LOG ***"
PRINT " *** Saved Log file to ";F$;" ***"
CLOSE 6
RETURN
'
'
' C L E A R S C R E E N
8190 IF IBM% = 0% THEN 8195
CLS
GOTO 8200
8195 PRINT
PRINT "..........................................................."
PRINT
8200 PRINT WZ$ : PRINT : PRINT
RETURN
'
'
'
' Y E S / N O Prompt Subroutine
8300 IF YES% <> 32% THEN PRINT " (";CHR$(YES%);" or ";CHR$(NO%);") ";
IF YES% = 32% THEN PRINT " ( ";CHR$(NO%);" or <CR> ) ";
Z$=" "
INPUT Z$
IF Z$ = "" AND YES% = 32 THEN REPLY% = 1% : GOTO 8400
IF Z$ = "" THEN 8300
REPLY% = 99%
ANS% = ASC(Z$)
IF ANS% > 90% THEN ANS% = ANS% - 32%
IF ANS% = YES% THEN REPLY% = 1%
IF ANS% = NO% THEN REPLY% = 0%
IF REPLY% <> 99% THEN 8400
PRINT " ERROR: Re-enter as follows: ";
GOTO 8300
8400 RETURN
'
'
' ------ character TRANSPOSITION -------
'
8600 FOR JJ% = 1% TO 128%
L=M%
S#=A#
GOSUB 3530
A#=S#
B%=O%
L=N%
S#=B#(B%)
GOSUB 3530
B#(B%)=S#
B%=O%
S#=C#(B%)
L=128
GOSUB 3530
C#(B%)=S#
IS% = CH%(JJ%)
CH%(JJ%) = CH%(O%)
CH%(O%) = IS%
NEXT JJ%
RETURN
'
'
'
8800 FOR JJ% = 1% TO 64%
G1%=CH%(JJ%)
G2%=CH%(JJ% + 64%)
G1$=MID$(M$,G1%,1)
G2$=MID$(M$,G2%,1)
MID$(M$,G1%,1)=G2$
MID$(M$,G2%,1)=G1$
NEXT JJ%
RETURN
'
'
'
9100 IF XL% = 1% THEN GOSUB 6060 ELSE GOSUB 8600
RETURN
'
'
'
9200 IF XL% = 1% THEN GOSUB 6340 ELSE GOSUB 8800
RETURN
'
'
'
' END